home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / SPX30.ZIP / DEMO08.ZIP / DEMO08.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1994-06-13  |  7.9 KB  |  225 lines
  1. Program Demo08;
  2.  
  3. { SPX library - GUI demo Copyright 1994 Scott D. Ramsay  }
  4.  
  5. {$X+ }  { Enable extended syntax }
  6.  
  7. Uses crt,spx_vga,spx_gui,spx_fnc,spx_sfn,spx_mos;
  8.  
  9. var
  10.   i      : Tobjlist;           { Data structure to hold objects }
  11.   cradio : integer;            { variable to keep track of which }
  12.                                { radio button is enabled }
  13.  
  14. { Initalize variables and create buttons, scrollers, etc }
  15. procedure setbuttons;
  16. var
  17.   p : pbutton;
  18. begin
  19.   i.init;      { init object structure }
  20.   cradio := 5; { Set radios to Default }
  21.   with i do
  22.     begin
  23.      { create buttons }
  24.       addobject(new(pbutton,init(20,20,65,20,1,#27,false,'|ESC| Quit')));
  25.       addobject(new(pbutton,init(20,40,65,20,2,'2',false,'Button 2')));
  26.      { create radio and check buttons }
  27.       addobject(new(pradio,init(90,20,65,20,5,1,'5',false,'Default |5|',cradio=5)));
  28.       addobject(new(pradio,init(90,40,65,20,6,1,'6',false,'Sienna |6|',cradio=6)));
  29.       addobject(new(pradio,init(90,60,65,20,7,1,'7',false,'Random |7|',cradio=7)));
  30.       addobject(new(pcheck,init(20,60,65,20,4,'4',false,'Chk box |4|',false)));
  31.      { create scrollers }
  32.       addobject(new(pscroll,init(20,100,100,15,8,1,100,1,50,true)));
  33.       addobject(new(pscroll,init(160,20,15,100,9,1,100,2,50,false)));
  34.      { create pick box }
  35.       addobject(new(ppbox,init(180,20,100,10,10,'Pick Box')));
  36.      { create string input boxes }
  37.       addobject(new(pstring,init(20,80,100,20,3,'3',false,'String','Scott',6)));
  38.       pstring(p)^.objectx := right;
  39.       p := addobject(new(pstring,init(20,120,40,18,11,#0,false,'','50',3)));
  40.      { modify horizontal placement of string in object }
  41.       pstring(p)^.objectx := center;
  42.     end;
  43. end;
  44.  
  45.  
  46. { Setup program }
  47. procedure setup;
  48. begin
  49.   openmode(2);   { open graphics mode with 1 virtual page }
  50.   randomize;     { set random seed }
  51.   cls(cl[1]);    { clear screen to desktop color }
  52.   setbuttons;    { set object buttons }
  53.   mousereset;    { init mouse routines }
  54.   setdefptr;     { Set the default mouse pointer shape }
  55.   mouseon;       { Make the mouse pointer visible }
  56. end;
  57.  
  58.  
  59. { Redraw the screen and objects: Draw on page 2 then update to }
  60. { reduce redrawing flicker }
  61. procedure redrawscreen;
  62. begin
  63.   setpageactive(2);     { set to page 2 }
  64.   cls(cl[1]);           { clear the screen }
  65.   i.showall;            { draw all objects }
  66.   mouseoff;             { hide the mouse }
  67.   pcopy(2,1);           { update the visual page }
  68.   mouseon;              { turn the mouse back on }
  69.   setpageactive(1);     { set page 1 as the active page }
  70. end;
  71.  
  72.  
  73. { Check the return handle values and does the button's functions }
  74. procedure CheckButtons(pr:integer;p:pbutton);
  75. { pr:integer;  Handle number of the object that was activated }
  76. { p:pbutton;   pointer to the activated object }
  77. var
  78.   s            : string;
  79.   randomcolors : wcolortypes;
  80.   t            : integer;
  81. begin
  82.   with i do
  83.     case pr of
  84.      { button - call disk dialog box }
  85.       2 : begin
  86.             s := diskdo(24,10,'','*','Enter file name to load',true);
  87.             if s<>''
  88.               then message('File is '+s,true);
  89.           end;
  90.      { check box - add an item to the pick box if the box is checked }
  91.       4 : if pcheck(p)^.tchk
  92.             then
  93.               begin
  94.                { get a pointer to the pick box object }
  95.                 p := retobject(10);
  96.                { add a string to the pick box }
  97.                 ppbox(p)^.additem('scott '+lz(ppbox(p)^.getcount+1,3),0,true);
  98.                { clear keyboard buffer and mouse presses }
  99.                 clearbuffer;
  100.               end;
  101.      { radio buttons - changes color only if random radio is selected or }
  102.      {  the radio was not selected }
  103.       5,6,7 : if (cradio<>pr) or (pr=7)
  104.                 then
  105.                   begin
  106.                     cradio := pr; { set the new radio button as selected }
  107.                     case pr of
  108.                       5 : menucolors := defaultcolors; { set default colors }
  109.                       6 : menucolors := burntsienna;   { set burnt color }
  110.                       7 : begin                        { set random colors }
  111.                             for t := 0 to 7 do
  112.                               with randomcolors[t] do
  113.                                 begin
  114.                                   red := random(63);
  115.                                   green := random(63);
  116.                                   blue := random(63);
  117.                                 end;
  118.                             menucolors := randomcolors;
  119.                           end;
  120.                     end;
  121.                     adjustmenupalette; { try to match sys colors with the }
  122.                                        {  current palette }
  123.                     redrawscreen;      { Redraw the screen with the new }
  124.                                        {  colors }
  125.                   end;
  126.      { Vertical scroller - update the string object }
  127.       9 : begin
  128.             t := pscroll(p)^.bpos; { grab the scroller position }
  129.             p := retobject(11);    { get a pointer to the string object }
  130.            { change the string value if the scroller value has changed }
  131.             if vl(pstring(p)^.tstr)<>t
  132.               then
  133.                 begin
  134.                   pstring(p)^.tstr := st(t); { change the string data to the }
  135.                                              {  scroller value }
  136.                   mouseoff;                  { hide mouse }
  137.                   p^.drawitemobject;         { redraw string object }
  138.                   mouseon;                   { display mouse }
  139.                 end;
  140.           end;
  141.      { pick box - display string picked }
  142.       10 : message('"Pick Box": '+ppbox(p)^.lhstr,true);
  143.      { string object - validate text entry, and update scroller }
  144.       11 : begin
  145.              t := vl(pstring(p)^.tstr);  { grab text string }
  146.              if not between(t,1,100)     { check for legal values }
  147.                then
  148.                  begin
  149.                   { bad value? Set the string to the current scroller pos }
  150.                    pstring(p)^.tstr := st(pscroll(retobject(9))^.bpos);
  151.                    mouseoff;
  152.                    p^.drawitemobject; { draw string object }
  153.                    mouseon;
  154.                  end
  155.               else
  156.                  begin
  157.                   { good value. }
  158.                    p := retobject(9); { get a pointer to the scroller }
  159.                    pscroll(p)^.bpos := t; { change the scroller position }
  160.                    mouseoff;
  161.                    p^.drawitemobject;     { redraw the scroller }
  162.                    mouseon;
  163.                  end;
  164.            end;
  165.     end;
  166. end;
  167.  
  168.  
  169. { Event loop }
  170. procedure eventloop;
  171. var
  172.   pr : integer; { keeps track of return handles }
  173.   p  : pbutton; { pointer to any activated objects }
  174. begin
  175.   redrawscreen; { draw screen }
  176.   with i do
  177.     repeat
  178.       inkey;                 { grab, keyboard and mouse values }
  179.       pr := CheckPress(p);   { scan, objects for actvation }
  180.       if pr<>0               { if CHECKPRESS returns a non-zero val, }
  181.                              { then an object was pressed or activated }
  182.         then CheckButtons(pr,p); { handle object }
  183.     until (pr=1) and yes('Quit SPXGUI test?'); { ask if want to quit. }
  184. end;
  185.  
  186.  
  187. { do some clean up }
  188. procedure cleanup;
  189. begin
  190.   i.done;    { deallocate object variables }
  191.   closemode; { close graphics mode }
  192. end;
  193.  
  194.  
  195. procedure showit;
  196. var
  197.   i : tObjList;
  198. begin
  199.   clrscr;
  200.   writeln('SPX library - GUI demo');
  201.   writeln('Copyright 1993 Scott D. Ramsay');
  202.   writeln;
  203.   writeln('Use mouse or keyboard to pick selections');
  204.   writeln(' Press the ESC or Click on Quit button to exit');
  205.   writeln;
  206.   write('Press SPACE to continue.');
  207.   i.init;
  208.   with i.io^ do
  209.     begin
  210.       clearbuffer;
  211.       repeat
  212.         inkey;
  213.       until (ch=' ') and not funct;
  214.     end;
  215.   i.done;
  216. end;
  217.  
  218.  
  219. begin
  220.   showit;
  221.   setup;
  222.   eventloop;
  223.   cleanup;
  224. end.
  225.